home *** CD-ROM | disk | FTP | other *** search
/ Dr. Windows 3 / dr win3.zip / dr win3 / PROGRAMR / WPJV1N3.ZIP / OWNERBTN.ZIP / OWNDRAW.PAS < prev    next >
Pascal/Delphi Source File  |  1993-02-15  |  6KB  |  170 lines
  1. unit OwnDraw;
  2. { This unit allows you to create BWCC style buttons without using BWCC.DLL.
  3.   It is by Todd T. Snoddy, and the source code is Copyright ⌐ Todd T. Snoddy.
  4.   You may use this unit as you like in your own programs.  I can be contacted via
  5.   Compuserve email at 71044,1653 or Internet at tsnoddy@nyx.cs.du.edu, or on
  6.   America OnLine at TSnoddy. }
  7.  
  8. interface
  9.  
  10. uses WObjects, WinTypes, WinProcs;
  11.  
  12. type ButtonState = (Normal, Focused, Pressed);
  13.  
  14. type
  15.   PODButton = ^TODButton;
  16.   TODButton = object(TButton)
  17.     HNormal, HPressed, HFocused :HBitmap;
  18.     State:ButtonState;
  19.     InitialDefault, IsCreating, HasCreated : Boolean;
  20.     constructor    Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
  21.       X,Y,W,H:Integer;IsDefault:Boolean;BMP:Integer);
  22.     constructor InitResource (AParent : PWindowsObject; ResourceID : Word; IsDefault : Boolean);
  23.     destructor Done;virtual;
  24.     procedure DrawItem(var Msg:TMessage);virtual;
  25.     procedure WMDrawItem (var Msg : TMessage); virtual wm_First+wm_DrawItem;
  26.     procedure WMSetFocus (var Msg : TMessage); virtual wm_First+wm_SetFocus;
  27.   end;
  28.  
  29. type
  30.   POwnerDialog = ^TOwnerDialog;
  31.   TOwnerDialog = object (TDialog)
  32.     Button : PODButton;
  33.     procedure WMDrawItem (var Msg : TMessage); virtual wm_First+wm_DrawItem;
  34.     procedure NewButton (ID : Integer; IsDefault : Boolean);
  35.   end;
  36.  
  37. implementation
  38.  
  39. procedure TOwnerDialog.WMDrawItem(var Msg:TMessage);
  40. var
  41.   PDrawStruct : ^TDrawItemStruct;
  42. begin
  43.   PDrawStruct := Pointer(Msg.lParam);
  44.   case PDrawStruct^.CtlType of  { Insure that message is for button control }
  45.     odt_Button:  SendDlgItemMsg (PDrawStruct^.CtlID, wm_DrawItem, Msg.wParam, Msg.lParam);
  46.                  { Notify button object that dialog received wm_DrawItem }
  47.   end;
  48. end;
  49.  
  50. procedure TOwnerDialog.NewButton (ID :  Integer; IsDefault : Boolean);
  51. begin
  52.   Button := New (PODButton, InitResource (@Self, ID, IsDefault));
  53. end;
  54.  
  55. constructor TODButton.Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
  56.        X,Y,W,H:Integer;IsDefault:Boolean;BMP:Integer);
  57. begin
  58.   TButton.Init(AParent,AnID,ATitle,X,Y,W,H,IsDefault);
  59.   Attr.Style := Attr.Style or bs_OwnerDraw;
  60.   IsCreating := True;
  61.   HasCreated := False;
  62.   if IsDefault then
  63.     InitialDefault := True
  64.   else
  65.     InitialDefault := False;
  66.   HNormal  := LoadBitmap (HInstance, MakeIntResource (BMP+1000));
  67.   HPressed := LoadBitmap (HInstance, MakeIntResource (BMP+3000));
  68.   HFocused := LoadBitmap (HInstance, MakeIntResource (BMP+5000));
  69. end;
  70.  
  71. constructor TODButton.InitResource (AParent : PWindowsObject; ResourceID : Word;
  72.                                       IsDefault : Boolean);
  73. begin
  74.   TButton.InitResource (AParent, ResourceID);
  75.   {  Call parent's InitResource object }
  76.   IsCreating := True;
  77.   HasCreated := False;
  78.   Attr.Style := Attr.Style or bs_OwnerDraw;
  79.   if IsDefault then
  80.     InitialDefault := True
  81.   else
  82.     InitialDefault := False;
  83.   { Load the bitmaps for this button }
  84.   HNormal  := LoadBitmap (HInstance, MakeIntResource (ResourceID+1000));
  85.   HPressed := LoadBitmap (HInstance, MakeIntResource (ResourceID+3000));
  86.   HFocused := LoadBitmap (HInstance, MakeIntResource (ResourceID+5000));
  87. end;
  88.  
  89. destructor TODButton.Done;
  90. begin
  91.   TButton.Done;
  92.   DeleteObject(HNormal);      { Delete normal bitmap from memory }
  93.   DeleteObject (HFocused);    { Delete focused bitmap from memory }
  94.   DeleteObject (HPressed);    { Delete pressed bitmap from memory }
  95. end;
  96.  
  97. procedure TODButton.WMDrawItem (var Msg : TMessage);
  98. begin
  99.   DrawItem (Msg);             { Call the procedure to display button }
  100. end;
  101.  
  102. procedure TODButton.WMSetFocus (var Msg : TMessage);
  103. {  This is necessary to properly display the focus at all times }
  104. begin
  105.   InvalidateRect (HWindow, nil, False);
  106.   UpdateWindow (HWindow);
  107.   DefWndProc (Msg);
  108. end;
  109.  
  110. procedure TODButton.DrawItem(var Msg:TMessage);
  111. { This is the procedure that actually draws the proper bitmap }
  112. var
  113.   OldBitMap, NewBitMap:HBitMap;
  114.   MemDC :HDC;
  115.   PDrawStruct :^TDrawItemStruct;
  116.   X,Y,W,H:Integer;
  117.   Rect : TRect;
  118.   bm : TBitmap;
  119.  
  120. begin
  121.   PDrawStruct := Pointer(Msg.lParam);
  122.   GetClientRect (HWindow, Rect);
  123.   State := Normal;
  124.   if (PDrawStruct^.itemAction and oda_Select ) > 0 then
  125.     begin
  126.       if (PDrawStruct^.itemState and ods_Selected) > 0 then
  127.         State :=  Pressed
  128.       else
  129.         if (PDrawStruct^.itemState and ods_Focus) > 0 then
  130.           State := Focused
  131.         else
  132.           State := Normal;
  133.     end;
  134.   if ((PDrawStruct^.itemAction and oda_Focus) > 0)
  135.     and not ((PDrawStruct^.itemAction and oda_Select) > 0) then
  136.       begin
  137.         if (PDrawStruct^.itemState and ods_Focus) > 0 then
  138.           State := Focused
  139.         else
  140.           State := Normal;
  141.       end;
  142.   X := PDrawStruct^.rcItem.left;Y := PDrawStruct^.rcItem.top;
  143.   W := PDrawStruct^.rcItem.right-PDrawStruct^.rcItem.left;
  144.   H := PDrawStruct^.rcItem.bottom-PDrawStruct^.rcItem.top;
  145.   MemDC := CreateCompatibleDC(PDrawStruct^.HDC);
  146.   { Following bitmaps are already initialized in InitResource }
  147.   if IsCreating and InitialDefault and HasCreated then
  148.     begin
  149.       IsCreating := False;
  150.       State := Focused;
  151.     end;
  152.   case State of
  153.     Normal : NewBitMap := HNormal;
  154.     Pressed : NewBitMap := HPressed;
  155.     Focused : NewBitMap := HFocused;
  156.   end;
  157.   OldBitMap := SelectObject (MemDC, NewBitMap);
  158.   GetObject (NewBitMap, sizeof (TBitmap), @bm);
  159.  
  160.     { Uses StretchBlt instead of BitBlt so that button is
  161.       resolution independent. }
  162.   StretchBlt (PDrawStruct^.HDC, 0, 0, Rect.right-1, Rect.bottom-1,
  163.                 MemDC, 0, 0, bm.bmWidth, bm.bmHeight, SrcCopy);
  164.   SelectObject(MemDC,OldBitMap);
  165.   DeleteDC(MemDC);
  166.   HasCreated := True;
  167.   Msg.Result := 1;  { Good practice, although not strictly necessary }
  168. end;
  169.  
  170. end.